home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / MYMUD21.ZIP / MMUD21.ZIP / SOURCE / 11_STUFF.ZIP / DB2BIN.ZIP / DB.PAS next >
Pascal/Delphi Source File  |  1993-06-12  |  12KB  |  586 lines
  1. Unit DB;
  2. Interface
  3. Uses OldHead;
  4.  
  5.  
  6. Type BufType   = Array[0..1023] Of Char;
  7.      StrPtr    = ^BufType;
  8.      AdvObject = Record
  9.                   Name     : StrPtr;
  10.                   Desc     : StrPtr;
  11.  
  12.  
  13.                   Location : Integer;
  14.                   Contents : Integer;
  15.                   Exits    : Integer;
  16.                   Next     : Integer;
  17.  
  18.                   Key      : StrPtr;
  19.                   Fail     : StrPtr;
  20.                   Success  : StrPtr;
  21.                   OFail    : StrPtr;
  22.                   OSuccess : StrPtr;
  23.  
  24.                   Owner    : Integer;
  25.                   Pennies  : Integer;
  26.                   Flags    : LongInt;
  27.                   Password : StrPtr;
  28.                  End;
  29.      AdvPtr    = ^AdvObject;
  30.  
  31.  
  32. Const MapSize = 5*1023;  { Maximal 5000 objects.. }
  33.  
  34. Var Map      : Array[0..MapSize] of AdvPtr;
  35.     MapCount : Word;
  36.     Buf      : BufType;
  37.  
  38. Procedure ReadDB;
  39. Procedure SaveDB;
  40. Procedure DisposeDB;
  41. Procedure PrintRecordToScreen(ObjNr : Integer);
  42. Function NewPlayer(NewName : String):Integer;
  43.  
  44.  
  45. Function IsRoom(ObjNr : Word):Boolean;
  46. Function IsThing(ObjNr : Word):Boolean;
  47. Function IsExit(ObjNr : Word):Boolean;
  48. Function IsPlayer(ObjNr : Word):Boolean;
  49.  
  50. Function IsWizard(ObjNr : Word):Boolean;
  51. Function IsDark(ObjNr : Word):Boolean;
  52. Function IsLinkOk(ObjNr : Word):Boolean;
  53. Function IsTemple(ObjNr : Word):Boolean;
  54. Function IsOwner(ObjNr : Word; PlayerNr : Word):Boolean;
  55. Function Controls(Who,What : Integer):Boolean;
  56. Function IsStiky(ObjNr : Word):Boolean;
  57. {
  58. Function IsBuilder(ObjNr : Word):Boolean;
  59. Function IsHaven(ObjNr : Word):Boolean;
  60. Function IsAbode(ObjNr : Word):Boolean;
  61. }
  62.  
  63. Type GenderType = (None,Neuter,Female,Male);
  64. Function WhichGender(ObjNr : Word):GenderType;
  65.  
  66. Function Asciiz2Str(B : BufType):String;
  67. Implementation
  68.  
  69. {$F+} Function HeapFunc(Size : Word):Integer; {$F-}
  70. Begin
  71.  HeapFunc:=-1;
  72. End;
  73.  
  74. Function Asciiz2Str(B : BufType):String;
  75. Var T : Word;
  76.     S : String;
  77. Begin
  78. T:=0;
  79. While B[T]<>#00 Do
  80.  Inc(T);
  81. If T>255
  82.    Then T:=255;
  83. Move(B[0],S[1],T);
  84. S[0]:=Chr(T);
  85. Asciiz2Str:=S;
  86. End;
  87.  
  88.  
  89. Const BufPtr    : Integer = 0;
  90.       MaxBuf    : Integer = 0;
  91.       BufSize             = 10*1024;
  92.  
  93. Type  Buffer    = Array[0..BufSize] of Char;
  94. Var   BufBuffer : Buffer;
  95.       InpEOF    : Boolean;
  96.  
  97. Function ReadByte(Var Inp : File;Var EOB : Boolean):Char;
  98. Begin
  99. EOB:=False;
  100. If (BufPtr=MaxBuf) Or  (MaxBuf=0)
  101.    Then Begin
  102.         FillChar(BufBuffer,SizeOf(BufBuffer),#00);
  103.         BlockRead(Inp,BufBuffer,SizeOf(Bufbuffer),MaxBuf);
  104.         If MaxBuf=0
  105.            Then Begin
  106.                 ReadByte:=#00;
  107.                 EOB:=True;
  108.                 Exit;
  109.                 End;
  110.         BufPtr:=0;
  111.         End;
  112. ReadByte:=BufBuffer[BufPtr];
  113. Inc(BufPtr);
  114. End;
  115.  
  116.  
  117. Function NewObject:AdvPtr;
  118. Var Tmp : AdvPtr;
  119. Begin
  120. New(Tmp);
  121. If Tmp=NIL
  122.    Then Begin
  123.         WriteLn;
  124.         WriteLn(' ■ Not enough memory!');
  125.         Dispose(HeapOrg);
  126.         Halt;
  127.         End;
  128. NewObject:=Tmp;
  129. End;
  130.  
  131. Function ReadInteger(Var F : File): Integer;
  132. Var S : String;
  133.     I : Integer;
  134.     E : Integer;
  135.     C : Char;
  136. Begin
  137. S:='';
  138. Repeat
  139.  C:=ReadByte(F,InpEOF);
  140.  Case C Of
  141.    #13,#10 : ;
  142.    Else S:=S+C;
  143.  End; {Case}
  144. Until C=#10;
  145. Val(S,I,E);
  146. If E<>0
  147.    Then I:=0;
  148. ReadInteger:=I;
  149. End;
  150.  
  151. Function ReadLongInt(Var F : File):LongInt;
  152. Var S : String;
  153.     I : LongInt;
  154.     E : Integer;
  155.     C : Char;
  156. Begin
  157. S:='';
  158. Repeat
  159.  C:=ReadByte(F,InpEOF);
  160.  Case C Of
  161.    #13,#10 : ;
  162.    Else S:=S+C;
  163.  End; {Case}
  164. Until C=#10;
  165. Val(S,I,E);
  166. If E<>0
  167.    Then I:=0;
  168. ReadLongInt:=I;
  169. End;
  170.  
  171.  
  172.  
  173. Function ReadString(Var F : File;Var Len : Word):StrPtr;
  174. Var C     : Char;
  175.     Count : Word;
  176.     Tmp   : StrPtr;
  177. Begin
  178. Count:=0;
  179. FillChar(Buf,SizeOf(Buf),#00);
  180. Repeat
  181.  C:=ReadByte(F,InpEOF);
  182.  Case C Of
  183.   #13,#10 :;
  184.   Else Begin
  185.        Buf[Count]:=C;
  186.        Inc(Count);
  187.        End;
  188.  End; {Case}
  189. Until C=#10;
  190. Inc(Count);
  191. GetMem(Tmp,Count);
  192. If Tmp=NIL
  193.    Then Begin
  194.         WriteLn(' ■ Not enough memory!');
  195.         Dispose(HeapOrg);
  196.         Halt;
  197.         End;
  198.  
  199. Tmp^:=Buf;
  200. ReadString:=Tmp;
  201. Len:=Count;
  202. End;
  203.  
  204.  
  205. Function CheckBit(Flag : LongInt;BitMap : LongInt):Boolean;
  206. Begin
  207. CheckBit:=(Flag And BitMap)=BitMap;
  208. End;
  209.  
  210. Function FieldLength(Var S : StrPtr):Word;
  211. Var Tmp : Word;
  212. Begin
  213. Tmp:=0;
  214. While S^[Tmp]<>#00 Do
  215.  Inc(Tmp);
  216. FieldLength:=Tmp+1;
  217. End;
  218.  
  219.  
  220. Procedure DisposeRecord(ObjNr : Integer);
  221. Begin
  222. With Map[ObjNr]^ Do
  223.  Begin
  224.  If Name<>Nil     Then FreeMem(Name,FieldLength(Name));
  225.  If Desc<>Nil     Then FreeMem(Desc,FieldLength(Desc));
  226.  If Key<>Nil      Then FreeMem(Key,FieldLength(Key));
  227.  If Fail<>Nil     Then FreeMem(Fail,FieldLength(Fail));
  228.  If Success<>Nil  Then FreeMem(Success,FieldLength(Success));
  229.  If OFail<>Nil    Then FreeMem(OFail,FieldLength(OFail));
  230.  If OSuccess<>Nil Then FreeMem(OSuccess,FieldLength(OSuccess));
  231.  If Password<>Nil Then FreeMem(Password,FieldLength(Password));
  232.  End; {With}
  233. Dispose(Map[ObjNr]);
  234. Map[ObjNr]:=NIL;
  235. End;
  236.  
  237.  
  238. Procedure DisposeDB;
  239. Var T : Word;
  240. Begin
  241. For T:=0 To MapCount Do
  242.  Begin
  243.  If Map[T]<>NIL
  244.     Then DisposeRecord(T);
  245.  End;
  246. End;
  247.  
  248.  
  249. Procedure ReadDB;
  250.  
  251. Var F      : File;
  252.     C      : Integer;
  253.     Dum    : StrPtr;
  254.     Len    : Word;
  255.     Stop   : Boolean;
  256.  
  257. Begin
  258. FillChar(Map,SizeOf(Map),#00);
  259. If ParamCount=0
  260.    Then Begin
  261.         WriteLn(' ■ Syntax: ');
  262.         WriteLn('   '+ParamStr(0)+' <DB file>');
  263.         Halt;
  264.         End;
  265. Assign(F,ParamStr(1));
  266. Reset(F,1);
  267. If IoResult<>0
  268.    Then Halt;
  269. WriteLn(' ■ Reading database');
  270.  
  271. C:=0;
  272. Stop:=False;
  273. While Not Stop Do
  274.  Begin
  275.  Dum:=ReadString(F,Len);
  276.  Stop:=Dum^[0]<>'#';
  277.  If Not Stop
  278.     Then Begin
  279.          Write(' ■ Rec: ',Asciiz2Str(Dum^),' ',MemAvail:7,#13);
  280.          FreeMem(Dum,Len);
  281.  
  282.          If MemAvail<2048
  283.             Then Begin
  284.                  WriteLn;
  285.                  WriteLn(' ■ Not enough memory available!');
  286.                  Dispose(HeapOrg);
  287.                  Halt;
  288.                  End;
  289.  
  290.          Map[C]:=NIL;
  291.          Map[C]:=NewObject;
  292.  
  293.          With Map[C]^ Do
  294.           Begin
  295.           Name      :=ReadString(F,Len);
  296.           Desc      :=ReadString(F,Len);
  297.  
  298.           Location  :=ReadInteger(F);
  299.           Contents  :=ReadInteger(F);
  300.           Exits     :=ReadInteger(F);
  301.           Next      :=ReadInteger(F);
  302.  
  303.           Key       :=ReadString(F,Len);
  304.           Fail      :=ReadString(F,Len);
  305.           Success   :=ReadString(F,Len);
  306.           OFail     :=ReadString(F,Len);
  307.           OSuccess  :=ReadString(F,Len);
  308.  
  309.           Owner     :=ReadInteger(F);
  310.           Pennies   :=ReadInteger(F);
  311.  
  312.           Flags     :=ReadLongInt(F);
  313.  
  314.           Password  :=ReadString(F,Len);
  315.           End; {With}
  316.          Inc(C);
  317.          End;
  318.  End;
  319. WriteLn;
  320. WriteLn(' ■ Ready..');
  321. Close(F);
  322. Dec(C);
  323. MapCount:=C;
  324. End; {ReadDB}
  325.  
  326.  
  327.  
  328. Procedure SaveDB;
  329. Var Out : Text;
  330.     C   : Integer;
  331.     Dum : String[30];
  332.  
  333. Procedure WriteDBRecord(Var Out : Text;ObjNr : Integer);
  334. Const NewField : Char = #$0A;
  335. Var   Dum      : String[10];
  336.  
  337. Procedure WriteField(Var Out : Text;P : StrPtr);
  338. Var C : Word;
  339. Begin
  340. C:=0;
  341. While P^[C]<>#00 Do
  342.  Begin
  343.  Write(Out,P^[C]);
  344.  Inc(C);
  345.  End;
  346. Write(Out,NewField);
  347. End;
  348.  
  349. Begin
  350. Write('#',ObjNr:3,#8#8#8#8);
  351. With map[ObjNr]^ Do
  352.  Begin
  353.  Str(ObjNr,Dum);
  354.  Write(Out,'#'+Dum,NewField);
  355.  WriteField(Out,Name);
  356.  WriteField(Out,Desc);
  357.  Write(Out,Location,NewField);
  358.  Write(Out,Contents,NewField);
  359.  Write(Out,Exits,NewField);
  360.  Write(Out,Next,NewField);
  361.  
  362.  WriteField(Out,Key);
  363.  WriteField(Out,Fail);
  364.  WriteField(Out,Success);
  365.  WriteField(Out,OFail);
  366.  WriteField(Out,OSuccess);
  367.  
  368.  Write(Out,Owner,NewField);
  369.  Write(Out,Pennies,NewField);
  370.  Write(Out,Flags,NewField);
  371.  WriteField(Out,Password);
  372.  End;
  373. End;
  374.  
  375.  
  376. Begin
  377. Assign(Out,ParamStr(2));
  378. Rewrite(Out);
  379. For C:=0 To MapCount Do
  380.  WriteDBRecord(Out,C);
  381. Dum:='***END OF DUMP***'+#$0A;
  382. Write(Out,Dum);
  383. Close(Out);
  384. If IoResult<>0
  385.    Then ;
  386. WriteLn('Ready');
  387. End;
  388.  
  389.  
  390. Function MakeString(Var P : StrPtr; S : String):Boolean;
  391. Begin
  392. MakeString:=False;
  393. GetMem(P,Length(S)+1);
  394. If P=Nil
  395.    Then Exit;
  396. FillChar(P^,Length(S)+1,#00);
  397. Move(S[1],P^[0],Length(S));
  398. MakeString:=True;
  399. End;
  400.  
  401.  
  402. Function NewPlayer(NewName : String):Integer;
  403. Var Sex   : Char;
  404.     Dum   : String;
  405. Begin
  406. NewPlayer:=NOTHING;
  407. Inc(MapCount);
  408. New(Map[MapCount]);
  409. If Map[MapCount]=NIL
  410.    Then Begin
  411.         Dec(MapCount);
  412.         Exit;
  413.         End;
  414.  
  415. If Not MakeString(Map[MapCount]^.Name,NewName)
  416.    Then Begin
  417.         DisposeRecord(MapCount);
  418.         Dec(MapCount);
  419.         Exit;
  420.         End;
  421.  
  422. With Map[MapCount]^ Do
  423.  Begin
  424.  Desc      := NIL;
  425.  Contents  := NOTHING;
  426.  Location  :=  0;
  427.  Exits     :=  0;
  428.  Next      := NOTHING;
  429.  
  430.  Fail      := Nil;
  431.  Success   := Nil;
  432.  OFail     := Nil;
  433.  OSuccess  := Nil;
  434.  
  435.  Owner     := MapCount;
  436.  Pennies   := 0;
  437.  
  438.  Flags     := Type_Player;
  439.  
  440.  WriteLn('Welkome new user!');
  441.  
  442.  Repeat
  443.   Write('Are you Male/Femal/Neuter/Quit? [M/F/N/Q]: ');
  444.   ReadLn(Sex);
  445.   WriteLn;
  446.  Until Upcase(Sex) in ['M','F','N','Q'];
  447.  
  448.  Case Upcase(Sex) Of
  449.   'N' : Flags:=Flags Or (Gender_Neuter Shl Gender_Shift);
  450.   'F' : Flags:=Flags Or (Gender_Female Shl Gender_Shift);
  451.   'M' : Flags:=Flags Or (Gender_Male Shl Gender_Shift);
  452.   'Q' : Begin
  453.         DisposeRecord(MapCount);
  454.         Dec(MapCount);
  455.         Exit;
  456.         End;
  457.  End;
  458.  
  459.  write('Give a password: ');
  460.  ReadLn(Dum);
  461.  If Not MakeString(Map[MapCount]^.Password,Dum)
  462.    Then Begin
  463.         DisposeRecord(MapCount);
  464.         Dec(MapCount);
  465.         Exit;
  466.         End;
  467.  End;
  468.  
  469. Map[MapCount]^.Next:=Map[0]^.Contents;
  470. Map[0]^.Contents:=MapCount;
  471. Map[MapCount]^.Location:=0;
  472. NewPlayer:=MapCount;
  473. End;
  474.  
  475.  
  476. Procedure PrintRecordToScreen(ObjNr : Integer);
  477. Begin
  478.  
  479. With Map[ObjNr]^ Do
  480.  Begin
  481.   WriteLn('====================================================');
  482.   WriteLn('Obj. Nr.: ',ObjNr);
  483.   WriteLn('Name    : ',Asciiz2Str(Name^));
  484.   WriteLn('Key     : ',ASciiz2Str(Key^));
  485.   WriteLn('Location: ',Location);
  486.   WriteLn('Next    : ',Next);
  487.   WriteLn('Exits   : ',Exits);
  488.   WriteLn('Contents: ',Contents);
  489.   WriteLn('Owner   : ',Owner);
  490.   WriteLn('Pennies : ',Pennies);
  491.   WriteLn('Flags   : ',Flags);
  492.   If IsPlayer(ObjNr)  Then Write('Player ');
  493.   If IsThing(ObjNr)   Then Write('Thing ');
  494.   If IsExit(ObjNr)    Then Write('Exit ');
  495.   If IsRoom(ObjNr)    Then Write('Room ');
  496.   If IsWizard(ObjNr)  Then Write('WIZ ');
  497.   WriteLn;
  498.   If IsDark(ObjNr)   Then Write('Dark ');
  499.   If IsTemple(ObjNr) Then Write('Temple ');
  500.   If IsLinkOk(ObjNr) Then Write('Link ');
  501.   WriteLn;
  502.  
  503.   WriteLn('====================================================');
  504.   End;
  505. End;
  506.  
  507.  
  508. Function IsRoom(ObjNr : Word):Boolean;
  509. Begin
  510. IsRoom:=(Map[ObjNr]^.Flags and TypeMask) = Type_Room;
  511. End;
  512.  
  513. Function IsThing(ObjNr : Word):Boolean;
  514. Begin
  515. IsThing:=(Map[ObjNr]^.Flags and TypeMask) = Type_Thing;
  516. End;
  517.  
  518. Function IsExit(ObjNr : Word):Boolean;
  519. Begin
  520. IsExit:=(Map[ObjNr]^.Flags and TypeMask) = Type_Exit;
  521. End;
  522.  
  523. Function IsPlayer(ObjNr : Word):Boolean;
  524. Begin
  525. IsPlayer:=(Map[ObjNr]^.Flags and TypeMask) = Type_Player;
  526. End;
  527.  
  528. Function IsWizard(ObjNr : Word):Boolean;
  529. Begin
  530. IsWizard:=(Map[ObjNr]^.Flags And Wizard)=Wizard;
  531. End;
  532.  
  533. Function IsDark(ObjNr : Word):Boolean;
  534. Begin
  535. IsDark:=(Map[ObjNr]^.Flags And Dark)=Dark;
  536. End;
  537.  
  538. Function IsLinkOk(ObjNr : Word):Boolean;
  539. Begin
  540. IsLinkOk:=(Map[ObjNr]^.Flags And Link_Ok)=Link_Ok;
  541. End;
  542.  
  543. Function IsTemple(ObjNr : Word):Boolean;
  544. Begin
  545. IsTemple:=(Map[ObjNr]^.Flags And Temple)=Temple;
  546. End;
  547.  
  548. Function IsOwner(ObjNr : Word; PlayerNr : Word):Boolean;
  549. Begin
  550. IsOwner:=Map[ObjNr]^.Owner=PlayerNr;
  551. End;
  552.  
  553.  
  554. Function IsStiky(ObjNr : Word):Boolean;
  555. Begin
  556. IsStiky:=(Map[ObjNr]^.Flags And STIKY) = STIKY;
  557. End;
  558.  
  559. {
  560. Function IsBuilder(ObjNr : Word):Boolean;
  561. Function IsHaven(ObjNr : Word):Boolean;
  562. Function IsAbode(ObjNr : Word):Boolean;
  563. }
  564.  
  565. Function Controls(Who,What : Integer):Boolean;
  566. Begin
  567. Controls:=IsWizard(Who) Or IsOwner(Who,What);
  568. End;
  569.  
  570.  
  571.  
  572. Function WhichGender(ObjNr : Word):GenderType;
  573. Begin
  574. WhichGender:=GenderType( (Map[ObjNr]^.Flags And Gender_Mask) Shr Gender_Shift);
  575. End;
  576.  
  577.  
  578. Begin
  579. HeapError:=@HeapFunc;
  580. InpEOF:=False;
  581.  
  582.  
  583.  
  584. End.
  585.  
  586.